home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / getfile / registry.bas < prev   
BASIC Source File  |  1997-05-10  |  4KB  |  109 lines
  1. Attribute VB_Name = "Module1"
  2. Public Const READ_CONTROL = &H20000
  3. Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
  4. Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
  5. Public Const KEY_QUERY_VALUE = &H1
  6. Public Const KEY_SET_VALUE = &H2
  7. Public Const KEY_CREATE_SUB_KEY = &H4
  8. Public Const KEY_ENUMERATE_SUB_KEYS = &H8
  9. Public Const KEY_NOTIFY = &H10
  10. Public Const KEY_CREATE_LINK = &H20
  11. Public Const SYNCHRONIZE = &H100000
  12. Public Const STANDARD_RIGHTS_ALL = &H1F0000
  13. Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
  14.    KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
  15.    And (Not SYNCHRONIZE))
  16. Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
  17.    KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
  18. Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
  19.    KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
  20.    Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) _
  21.    And (Not SYNCHRONIZE))
  22. Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
  23.  
  24. Public Const ERROR_SUCCESS = 0&
  25.  
  26. Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  27.    Alias "RegOpenKeyExA" (ByVal hKey As Long, _
  28.    ByVal lpSubKey As String, ByVal ulOptions As Long, _
  29.    ByVal samDesired As Long, phkResult As Long) As Long
  30. Declare Function RegQueryValueEx Lib "advapi32.dll" _
  31.    Alias "RegQueryValueExA" (ByVal hKey As Long, _
  32.    ByVal lpValueName As String, ByVal lpReserved As Long, _
  33.    lpType As Long, lpData As Any, lpcbData As Long) As Long
  34. Declare Function RegCloseKey Lib "advapi32.dll" _
  35.    (ByVal hKey As Long) As Long
  36.  
  37. Function Getfiles() As String
  38. On Error GoTo errorhandler:
  39.   Dim vwbtmp$
  40.   Dim wbrows$
  41.   Dim exeplace As Integer
  42.   Dim lgnType As Long
  43.   
  44.  
  45.   vwbtmp$ = sdaGetRegEntry("HKEY_CLASSES_ROOT", "." & Leifens1.Combo1.Text, "", lgnType)
  46.   vwbtmp$ = Left$(vwbtmp$, (Len(vwbtmp$) - 1))
  47.   vwbtmp$ = vwbtmp$ + "\shell\open\command"
  48.   wbrows$ = sdaGetRegEntry("HKEY_CLASSES_ROOT", vwbtmp$, "", lgnType)
  49.   exeplace = (InStr(LCase(wbrows$), ".exe"))
  50.   wbrows$ = Left$(wbrows$, exeplace + 3)
  51.   If Mid$(wbrows$, 1, 1) = Chr$(34) Then
  52.   wbrows$ = Right$(wbrows$, (Len(wbrows$) - 1))
  53.   End If
  54.   Getfiles = wbrows$
  55.   
  56. errorhandler:
  57.   Exit Function
  58.   
  59. End Function
  60.  
  61.  
  62. Function sdaGetRegEntry(strKey As String, _
  63.    strSubKeys As String, strValName As String, _
  64.    lngType As Long) As String
  65. On Error GoTo sdaGetRegEntry_Err
  66.  
  67.   Dim lngResult As Long, lngKey As Long
  68.   Dim lngHandle As Long, lngcbData As Long
  69.   Dim strRet As String
  70.  
  71.   Select Case strKey
  72.     Case "HKEY_CLASSES_ROOT": lngKey = &H80000000
  73.     Case "HKEY_CURRENT_CONFIG": lngKey = &H80000005
  74.     Case "HKEY_CURRENT_USER": lngKey = &H80000001
  75.     Case "HKEY_DYN_DATA": lngKey = &H80000006
  76.     Case "HKEY_LOCAL_MACHINE": lngKey = &H80000002
  77.     Case "HKEY_PERFORMANCE_DATA": lngKey = &H80000004
  78.     Case "HKEY_USERS": lngKey = &H80000003
  79.     Case Else: Exit Function
  80.   End Select
  81.     
  82.   If Not ERROR_SUCCESS = RegOpenKeyEx(lngKey, _
  83.      strSubKeys, 0&, KEY_READ, _
  84.      lngHandle) Then Exit Function
  85.   
  86.   lngResult = RegQueryValueEx(lngHandle, strValName, _
  87.      0&, lngType, ByVal strRet, lngcbData)
  88.   strRet = Space(lngcbData)
  89.   lngResult = RegQueryValueEx(lngHandle, strValName, _
  90.      0&, lngType, ByVal strRet, lngcbData)
  91.   
  92.   If Not ERROR_SUCCESS = RegCloseKey(lngHandle) Then _
  93.      lngType = -1&
  94.     
  95.   sdaGetRegEntry = strRet
  96.   
  97. sdaGetRegEntry_Exit:
  98.   On Error GoTo 0
  99.   Exit Function
  100.  
  101. sdaGetRegEntry_Err:
  102.   lngType = -1&
  103.   MsgBox Err & ">  " & Error$, 16, _
  104.      "GenUtils/sdaGetRegEntry"
  105.   Resume sdaGetRegEntry_Exit
  106.  
  107. End Function
  108.  
  109.